﻿
Imports Microsoft.SharePoint

Module Module1

    Sub Main()

        Dim site As New SPSite(My.Settings.siteURL)
        site.OpenWeb()

        Dim webCol As SPWebCollection = site.AllWebs
        Dim web As SPWeb
        Dim webroleassignments As List(Of SPRoleAssignment)

        For Each web In webCol
            Console.WriteLine(vbCrLf & "\\\\\\ site: " & web.Name & "; Inheritance broken: " & web.HasUniqueRoleAssignments.ToString)
            webroleassignments = New List(Of SPRoleAssignment)

            For Each role As SPRoleAssignment In web.RoleAssignments
                If isSharepointGroup(role) Then
                    If web.HasUniqueRoleAssignments Then MigrateADGroupsInSharepointGroup(role)
                Else
                    Dim principal As SPPrincipal = role.Member
                    Dim roleuser As SPUser = CType(principal, SPUser)
                    Dim binds As SPRoleDefinitionBindingCollection = role.RoleDefinitionBindings
                    For Each bind As SPRoleDefinition In binds
                        If web.HasUniqueRoleAssignments = False Then GoTo nextwebbind
                        If roleuser.IsDomainGroup = False Then GoTo nextwebbind
                        If InStr(bind.Name, "Limited Access") > 0 Then GoTo nextwebbind
                        If InStr(roleuser.LoginName, My.Settings.olddomain) = 0 Then GoTo nextwebbind
                        Try
                            Dim newroleass As New SPRoleAssignment(web.EnsureUser(SwapGroups(roleuser.LoginName)))
                            newroleass.RoleDefinitionBindings.Add(bind)
                            webroleassignments.Add(newroleass)
                        Catch ex As SPException
                            Console.WriteLine("ERROR: " & ex.Message & " :: while adding " & SwapGroups(roleuser.LoginName) & " to " & web.Name)
                        End Try
nextwebbind:
                    Next bind
                End If
            Next role
            If My.Settings.makechanges And webroleassignments.Count > 0 Then UpdateWeb(web, webroleassignments)

            For Each list As SPList In web.Lists
                Console.WriteLine(vbCrLf & "list: " & list.Title & "; Inheritance broken: " & list.HasUniqueRoleAssignments.ToString)
                webroleassignments = New List(Of SPRoleAssignment)

                For Each role As SPRoleAssignment In list.RoleAssignments
                    If isSharepointGroup(role) Then
                        If list.HasUniqueRoleAssignments Then MigrateADGroupsInSharepointGroup(role)
                    Else
                        Dim principal As SPPrincipal = role.Member
                        Dim roleuser As SPUser = CType(principal, SPUser)
                        Dim binds As SPRoleDefinitionBindingCollection = role.RoleDefinitionBindings
                        For Each bind As SPRoleDefinition In binds
                            If list.HasUniqueRoleAssignments = False Then GoTo nextlistbind
                            If roleuser.IsDomainGroup = False Then GoTo nextlistbind
                            If InStr(bind.Name, "Limited Access") > 0 Then GoTo nextlistbind
                            If InStr(roleuser.LoginName, My.Settings.olddomain) = 0 Then GoTo nextlistbind
                            Try
                                Dim newroleass As New SPRoleAssignment(web.EnsureUser(SwapGroups(roleuser.LoginName)))
                                newroleass.RoleDefinitionBindings.Add(bind) 'roledef)
                                webroleassignments.Add(newroleass)
                            Catch ex As SPException
                                Console.WriteLine("ERROR: " & ex.Message & " :: while adding " & SwapGroups(roleuser.LoginName) & " to " & web.Name)
                            End Try
nextlistbind:
                        Next bind
                    End If
                Next role
                If My.Settings.makechanges And webroleassignments.Count > 0 Then Updatelist(web, list, webroleassignments)

                Dim query As New SPQuery()
                query.ViewAttributes = "Scope=""Recursive"""
                Dim myItems As SPListItemCollection = list.GetItems(query)
                Dim folder As SPListItem

                For Each folder In myItems
                    Console.WriteLine(vbTab & "folder/doc: " & folder.Name & "; Inheritance broken: " & folder.HasUniqueRoleAssignments.ToString)
                    webroleassignments = New List(Of SPRoleAssignment)

                    For Each role As SPRoleAssignment In folder.RoleAssignments
                        If isSharepointGroup(role) Then
                            If folder.HasUniqueRoleAssignments Then MigrateADGroupsInSharepointGroup(role)
                        Else
                            Dim principal As SPPrincipal = role.Member
                            Dim roleuser As SPUser = CType(principal, SPUser)
                            Dim binds As SPRoleDefinitionBindingCollection = role.RoleDefinitionBindings
                            For Each bind As SPRoleDefinition In binds
                                If folder.HasUniqueRoleAssignments = False Then GoTo nextitembind
                                If roleuser.IsDomainGroup = False Then GoTo nextitembind
                                If InStr(bind.Name, "Limited Access") > 0 Then GoTo nextitembind
                                If InStr(roleuser.LoginName, My.Settings.olddomain) = 0 Then GoTo nextitembind
                                Try
                                    Dim newroleass As New SPRoleAssignment(web.EnsureUser(SwapGroups(roleuser.LoginName)))
                                    newroleass.RoleDefinitionBindings.Add(bind)
                                    webroleassignments.Add(newroleass)
                                Catch ex As SPException
                                    Console.WriteLine("ERROR: " & ex.Message & " :: while adding " & SwapGroups(roleuser.LoginName) & " to " & web.Name)
                                End Try
nextitembind:
                            Next bind

                        End If
                    Next role
                    If My.Settings.makechanges And webroleassignments.Count > 0 Then UpdateFolder(web, folder, webroleassignments)

                Next folder

            Next list
nextweb:
        Next web

    End Sub

    Private Sub MigrateADGroupsInSharepointGroup(ByVal role As SPRoleAssignment)

        Dim principal As SPPrincipal = role.Member
        Dim rolegroup As SPGroup = CType(principal, SPGroup)
        Dim list As New List(Of SPUser)
  
        For Each roleuser As SPUser In rolegroup.Users
            If Not IsNothing(SwapGroups(roleuser.LoginName)) And roleuser.IsDomainGroup Then list.Add(roleuser)
        Next

        For Each s As SPUser In list
            Console.WriteLine("Converting domain group " & s.LoginName & " to " & SwapGroups(s.LoginName))
            Try
                If My.Settings.makechanges Then rolegroup.Users.Add(SwapGroups(s.LoginName), s.Email, SwapGroups(s.LoginName), "(migrated) " & s.Notes)
            Catch ex As SPException
                Console.WriteLine("ERROR: " & ex.Message & " :: while adding " & SwapGroups(s.LoginName) & " to " & rolegroup.Name)
            End Try
        Next

        Console.WriteLine("Saving role " & role.Member.Name)
        If My.Settings.makechanges Then rolegroup.Update()

    End Sub

    Private Function SwapGroups(ByVal group As String) As String

        If InStr(group, My.Settings.olddomain) > 0 Then
            SwapGroups = My.Settings.newdomain & "\" & Split(group, "\").GetValue(1)
        Else
            SwapGroups = Nothing
        End If

    End Function

    Private Function isSharepointGroup(ByVal role As SPRoleAssignment) As Boolean

        Try
            If InStr(role.Member.GetType.ToString, "SPUser") > 0 Then
                Dim principal As SPPrincipal = role.Member
                Dim roleuser As SPUser = CType(principal, SPUser)
                isSharepointGroup = False
            Else
                Dim principal As SPPrincipal = role.Member
                Dim rolegroup As SPGroup = CType(principal, SPGroup)
                Dim principals As String = ""
                For Each roleuser As SPUser In rolegroup.Users
                    principals = principals + roleuser.LoginName + "; "
                Next
                isSharepointGroup = True
            End If

        Catch ex As Exception
            Console.WriteLine(ex.Message & vbTab & ex.InnerException.ToString)
            Return Nothing
        End Try

    End Function


    Private Sub UpdateWeb(ByVal web As SPWeb, ByVal roleassignments As List(Of SPRoleAssignment))

        Using site As New SPSite(My.Settings.siteURL)
            site.OpenWeb()
            Dim myweb As SPWeb = site.OpenWeb(web.ID)

            For Each r As SPRoleAssignment In roleassignments
                Console.WriteLine("===> adding " & r.Member.Name & " to web " & web.Name)
                myweb.RoleAssignments.Add(r)
            Next
            Console.WriteLine("=> saving " & myweb.Name)
            myweb.Update()

        End Using

    End Sub


    Private Sub Updatelist(ByVal web As SPWeb, ByVal list As SPList, ByVal roleassignments As List(Of SPRoleAssignment))

        Using site As New SPSite(My.Settings.siteURL)
            site.OpenWeb()
            Dim myweb As SPWeb = site.OpenWeb(web.ID)

            Try
                Console.WriteLine("Fetching list " & list.Title & " for update; ID " & list.ID.ToString)
                Dim mylist As SPList = myweb.GetListFromUrl(list.DefaultViewUrl)

                Console.WriteLine("Got list " & list.DefaultViewUrl)
                For Each r As SPRoleAssignment In roleassignments
                    Console.WriteLine("===> adding " & r.Member.Name & " to list " & mylist.Title)
                    mylist.RoleAssignments.Add(r)
                Next
                Console.WriteLine("=> saving " & mylist.Title)
                mylist.Update()

            Catch ex As Exception
                Console.WriteLine("ERROR: " & ex.Message & vbCrLf & ex.InnerException.ToString)
            End Try

        End Using

    End Sub

    Private Sub UpdateFolder(ByVal web As SPWeb, ByVal folder As SPListItem, ByVal roleassignments As List(Of SPRoleAssignment))

        Using site As New SPSite(My.Settings.siteURL)
            site.OpenWeb()
            Dim myweb As SPWeb = site.OpenWeb(web.ID)
            Dim myfolder As SPFolder = myweb.GetFolder(folder.Url)
            For Each r As SPRoleAssignment In roleassignments
                Console.WriteLine("===> adding " & r.Member.Name & " to folder " & myfolder.Name)
                myfolder.Item.RoleAssignments.Add(r)
            Next
            Console.WriteLine("=> saving " & myfolder.Name)
            myfolder.Update()

        End Using

    End Sub

End Module
